home *** CD-ROM | disk | FTP | other *** search
/ PC-Blue - MS DOS Public Domain Library / PC-Blue MS-DOS Public Domain Library - NYACC.iso / vol029 / graphchi.bas < prev    next >
Encoding:
BASIC Source File  |  1987-01-11  |  5.4 KB  |  143 lines
  1. 1 '****  ALGEBRA AND GEOMETRY PROGRAM
  2. 3 ON ERROR GOTO 800
  3. 5 CLEAR : KEY OFF : FALSE = 0 : TRUE = NOT FALSE
  4. 6 SCREEN 0 : WIDTH 80
  5. 7 '****  MONOCHROME SENSING ROUTINE
  6. 8 DEF SEG=&H40 : DISPLAY=PEEK(&H10)
  7. 9 IF (DISPLAY AND &H30) = &H30 THEN MONOCHROME = TRUE ELSE MONOCHROME = FALSE
  8. 10 SCREEN 0 : WIDTH 80
  9. 12 CLS : PRINT "ALGEBRA Graphics Program"
  10. 14 PRINT "    Steve VanArsdale"
  11. 16 PRINT "Mt.Prospect, Illinois  312-259-7224"
  12. 18 PRINT
  13. 20 PRINT "SELECT algebra function:"
  14. 30 PRINT "A ... for the SINE of X"
  15. 40 PRINT "B ... for the COSINE of X"
  16. 50 PRINT "C ... for the TANGENT of X"
  17. 51 PRINT "D ... for the SECANT of X"
  18. 52 PRINT "E ... for the COTANGENT of X"
  19. 53 PRINT "F ... for the COSECANT of X"
  20. 54 PRINT "G ... for the INVERSE HYPERBOLIC SINE of X"
  21. 55 PRINT "H ... for the SQUARE ROOT of X"
  22. 60 PRINT " > ";:CHOICE$=INPUT$(1)
  23. 70 IF CHOICE$ ="A" OR CHOICE$ = "a" THEN DEF FNFUNCTION(X)=SIN(X):FUNCTION$="SIN(X)":GOTO 110
  24. 80 IF CHOICE$ ="B" OR CHOICE$ = "b"  THEN DEF FNFUNCTION(X)=COS(X):FUNCTION$="COSINE(X)":GOTO 110
  25. 90 IF CHOICE$ ="C" OR CHOICE$ = "c" THEN DEF FNFUNCTION(X)=TAN(X):FUNCTION$="TANGENT(X)":GOTO 110
  26. 91 IF CHOICE$ ="D" OR CHOICE$ = "d" THEN DEF FNFUNCTION(X)=1/COS(X):FUNCTION$="SECANT(X)":GOTO 110
  27. 92 IF CHOICE$ ="E" OR CHOICE$ = "e" THEN DEF FNFUNCTION(X)=1/TAN(X):FUNCTION$="COTANGENT(X)":GOTO 110
  28. 93 IF CHOICE$ ="F" OR CHOICE$ = "f" THEN DEF FNFUNCTION(X)=1/SIN(X):FUNCTION$="COSECANT(X)":GOTO 110
  29. 94 IF CHOICE$ ="G" OR CHOICE$ = "g" THEN DEF FNFUNCTION(X)=LOG(X+SQR(X*X+1)):FUNCTION$="INVERSE HYPERBOLIC SINE(X)":GOTO 110
  30. 95 IF CHOICE$ ="H" OR CHOICE$ = "h" THEN DEF FNFUNCTION(X)=SQR(ABS(X)):FUNCTION$="SQ.RT(X)":GOTO 110
  31. 100 GOTO 10
  32. 110 PRINT "DEPTH OF ";FUNCTION$;" GRAPH (0 TO 50): ";:INPUT "",DEPTH
  33. 115 IF DEPTH < 0 OR DEPTH > 50 THEN GOTO 110
  34. 120 CLS:SCREEN 0 :WIDTH 80
  35. 155 '**** ACTIVATION OF COLOR/GRAPHICS MONITOR IF AVAILABLE ****
  36. 160 IF MONOCHROME = TRUE THEN WIDTH 80: DEF SEG=0: A=PEEK(&H410): POKE &H410,(A AND &HCF) OR &H20 : SCREEN 0 : WIDTH 80
  37. 170 SCREEN 0 :WIDTH 80
  38. 190 KEY(10) ON : ON KEY(10) GOSUB 800 : KEY(10) STOP
  39. 200 '****   GRAPHICS ROUTINE FOR ALGEBRAIC FUNCTIONS ****
  40. 205 CLS
  41. 210 SCREEN 1,0:COLOR 0,1
  42. 220 C=100:R=100
  43. 230 '** AXIS DRAWING ROUTINE
  44. 240 GOSUB 900
  45. 245 '** PLOTTING PARAMETERS DISPLAY
  46. 250 LOCATE 17,1:PRINT "GRAPH of:"
  47. 260 LOCATE 18,1:PRINT FUNCTION$
  48. 270 LOCATE 20,1:PRINT "  X     Y"
  49. 275 '** PLOTTING ROUTINE
  50. 277 X=0:Y=0:XX=-1:YY=FNFUNCTION(XX):PSET(100,100)
  51. 278 RANDOMIZE 1000 : PLAY "MBO2T200L64MS"
  52. 280 FOR X = -1 TO 7 STEP .1
  53. 282 NOTE=INT(RND*83+1)
  54. 285 PLAY "N="+VARPTR$(NOTE)
  55. 290 LOCATE 21,1:PRINT USING "##.##";X
  56. 295 KEY(10) ON : KEY(10) STOP
  57. 300 Y = FNFUNCTION(X)
  58. 302 YLIMIT=98-30*Y : DEPTHLIMIT=100-30*Y-DEPTH : IF YLIMIT < 0 OR YLIMIT > 200 OR DEPTHLIMMT < 0 THEN GOTO 390
  59. 305 ON ERROR GOTO 1000
  60. 310 LOCATE 21,7:PRINT USING "##.##";Y
  61. 320 PSET(20*X+100,100-30*Y),2
  62. 330 IF DEPTH <> 0 THEN LINE (20*X+101,99-30*Y)-(20*X+100+DEPTH,100-30*Y-DEPTH),1
  63. 350 LINE (20*XX+100,100-30*YY)-(20*X+100,100-30*Y),2
  64. 360 IF DEPTH <> 0 THEN LINE (20*XX+100+DEPTH,100-30*YY-DEPTH)-(20*X+100+DEPTH,100-30*Y-DEPTH),2
  65. 390 XX=X:YY=Y
  66. 400 NEXT X
  67. 405 GOSUB 900
  68. 410 LOCATE 25,1: PRINT "ENTER  X  TO EXIT";:VALUE$=INPUT$(1)
  69. 415 IF VALUE$ <> "X" AND VALUE$ <> "x" THEN GOTO 10 ELSE CLS : KEY(10) ON
  70. 420 '****  SPECIAL EXIT DISPLAY ****
  71. 425 '** AXIS DRAWING SUBROUTINE
  72. 427 GOSUB 900
  73. 430 '** PLANE GRID DRAWING ROUTINE
  74. 431 FOR X = 10 TO R-10 STEP 10
  75. 432 LINE (C+X,R-X)-(105+C+X,R-X),1
  76. 433 LINE (C+X,R-X)-(C+X,0),1
  77. 434 LINE (C,R-X)-(195-X,5),1
  78. 435 LINE (C+X,R)-(195+X,5),1
  79. 436 NEXT X
  80. 438 LOCATE 1,22:PRINT " Z axis"
  81. 440 '** HOOP ROUTINE
  82. 450 CIRCLE (160,90),50,2,,,1
  83. 460 FOR I = 1 TO 20
  84. 470 CIRCLE STEP (1,-1),50,2,,,1
  85. 480 NEXT I
  86. 490 CIRCLE (160,90),50,0,,,1
  87. 500 '** ELLIPTICAL TUBE ROUTINE
  88. 505 CIRCLE (155,90),25,1,,,.5
  89. 510 FOR I = 1 TO 35
  90. 520 CIRCLE STEP (1,1),25,1,,,.5
  91. 530 NEXT I
  92. 540 CIRCLE STEP (1,1),25,0,,,.5
  93. 550 CIRCLE (155,90),25,0,0,3.14,.5
  94. 560 FOR I = 1 TO 20
  95. 570 CIRCLE STEP (1,-1),24,1,,,.5
  96. 580 NEXT I
  97. 590 CIRCLE (155,90),25,2,0,3.14,.5
  98. 600 '***  CONE ROUTINE
  99. 605 CIRCLE (45,55),38,3,,,1
  100. 610 FOR I = 1 TO 38
  101. 620 CIRCLE STEP (+1,-1),38-I,(I MOD 2)+2,,,1
  102. 630 NEXT I
  103. 640 CIRCLE (45,55),38,0,,,1
  104. 650 '**  GLOBE ROUTINE
  105. 655 CIRCLE (245,170),1,2,,,3
  106. 660 FOR I = 1 TO 10 STEP 1
  107. 670 CIRCLE STEP (+I/4,-I/4),I*4,1,,,1
  108. 680 NEXT I
  109. 690 FOR I = 10 TO 0 STEP -1
  110. 700 CIRCLE STEP (+I/4,-I/4),I*4,2,,,1
  111. 710 NEXT I
  112. 715 LINE -(245,170),3
  113. 720 '** PYRAMID ROUTINE
  114. 740 DRAW "BM10,150;C1;E30;F30;L60"
  115. 745 DRAW "BM+30,-28;D13"
  116. 750 LINE (40,135)-(11,149),1
  117. 760 LINE (40,135)-(69,149),1
  118. 770 '** CUBE ROUTINE
  119. 775 DRAW "BM265,85;C3;U30;R30;D30;L30"
  120. 780 DRAW "BM+20,-20;C3;U30;R30;D30;L30"
  121. 790 DRAW "C3;G20;BM+30,0;E20;BM+0,-30;G20;BM-30,0;E20"
  122. 799 LOCATE 25,1: PRINT "BYE.";
  123. 800 '**** TERMINATION LOGIC
  124. 805 IF MONOCHROME = TRUE THEN WIDTH 40: DEF SEG=0: A=PEEK(&H410): POKE &H410,A OR &H30 : SCREEN 0 : WIDTH 80 ELSE FOR I = 1 TO 2000 : NEXT I
  125. 840 CLS: PRINT "ALGEBRA Program Terminated."
  126. 845 END
  127. 900 '****  AXIS DRAWING SUBROUTINE ****
  128. 920 '****  AXIS DRAWING SUBROUTINE ****
  129. 921 LINE (C,0)-(C,199)
  130. 922 LINE (90,110)-(200,0)
  131. 924 LINE (0,R)-(319,R)
  132. 925 LOCATE 13,1:PRINT "X axis"
  133. 926 LOCATE 2,10:PRINT "Y axis"
  134. 927 LOCATE 1,22:PRINT " Z axis"
  135. 930 RETURN
  136. 1000 '****  CALCULATION ERROR HANDLER
  137. 1010 RESUME 390
  138. 1210 CLS : PRINT "ALGEBRA Graphics Program"
  139. NT " Z axis"
  140. 930 RETURN
  141. 1000 '****  CALCULATION ERROR HANDLER
  142. 1010 RESUME 390
  143. 1210 CLS : PRIN